home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0171_3D Prism.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  5KB  |  155 lines
  1. program Prism3D;
  2. {Author: Krisjanis Gale, 10/06/94}
  3. {MY FIRST WORKING 3D OBJECT!}
  4. uses
  5.     Gfx2,
  6.     Crt;
  7. {<■────────────────────────────────────────────────────────────────────────■>}
  8. type
  9.     vector=record
  10.              x,y,z:integer;
  11.            end;
  12. {<■────────────────────────────────────────────────────────────────────────■>}
  13. var
  14.    deltaPRISM:array[0..11,0..1] of vector;
  15.    ValCos:array[0..359] of real;
  16.    ValSin:array[0..359] of real;
  17.    k,sc:integer;
  18. {<■────────────────────────────────────────────────────────────────────────■>}
  19. const
  20.      Zscale=256;  {total z-coord depth}
  21.      deltaZ=256;  {by how much to move points "back" in z-plane}
  22.      {A simple 8-sided prism}
  23.      prism:array[0..11,0..1] of vector=
  24.        ((( x:0;  y:0;  z:1 ),( x:1;  y:0;  z:0 )),
  25.         (( x:0;  y:0;  z:1 ),( x:0;  y:1;  z:0 )),
  26.         (( x:0;  y:0;  z:1 ),( x:-1; y:0;  z:0 )),
  27.         (( x:0;  y:0;  z:1 ),( x:0;  y:-1; z:0 )),
  28.         (( x:0;  y:0;  z:-1),( x:1;  y:0;  z:0 )),
  29.         (( x:0;  y:0;  z:-1),( x:0;  y:1;  z:0 )),
  30.         (( x:0;  y:0;  z:-1),( x:-1; y:0;  z:0 )),
  31.         (( x:0;  y:0;  z:-1),( x:0;  y:-1; z:0 )),
  32.         (( x:1;  y:0;  z:0 ),( x:0;  y:1;  z:0 )),
  33.         (( x:0;  y:1;  z:0 ),( x:-1; y:0;  z:0 )),
  34.         (( x:-1; y:0;  z:0 ),( x:0;  y:-1; z:0 )),
  35.         (( x:0;  y:-1; z:0 ),( x:1;  y:0;  z:0 )));
  36. {<■────────────────────────────────────────────────────────────────────────■>}
  37. procedure Get2D(x,y,z:integer;var sX:integer;var sY:byte);
  38. begin
  39.      sX:=trunc(((x*Zscale)/z)+160);
  40.      sY:=trunc(((y*Zscale)/z)+100)
  41. end;
  42. {<■────────────────────────────────────────────────────────────────────────■>}
  43. function GetCos(i:integer):real;
  44. var
  45.    c:real;
  46. begin
  47.      if i<0 then
  48.         i:=-(abs(i) mod 360)+360;
  49.      c:=ValCos[i mod 360];
  50.      GetCos:=c
  51. end;
  52. {<■────────────────────────────────────────────────────────────────────────■>}
  53. function GetSin(i:integer):real;
  54. var
  55.    s:real;
  56. begin
  57.      if i<0 then
  58.         i:=-(abs(i) mod 360)+360;
  59.      s:=ValSin[abs(i) mod 360];
  60.      GetSin:=s
  61. end;
  62. {<■────────────────────────────────────────────────────────────────────────■>}
  63. procedure Rot3D(var X,Y,Z:integer;rotX,rotY,rotZ:integer);
  64.   {Trigonometrically rotate an (x,y,z) coordinate by}
  65.   {degrees of rotation on the three axes; K.Gale, 9/21/94}
  66. var
  67.    cosX,sinX,cosY,sinY,cosZ,sinZ:real;
  68.    tX,tY,tZ:integer;
  69. begin
  70.      cosX:=GetCos(rotX);
  71.      sinX:=GetSin(rotX);
  72.      cosY:=GetCos(rotY);
  73.      sinY:=GetSin(rotY);
  74.      cosZ:=GetCos(rotZ);
  75.      sinZ:=GetSin(rotZ);
  76.      tX:=X; tY:=Y; tZ:=Z;
  77.      tX:=trunc(X*cosY-Z*sinY);   {yaw}
  78.      tZ:=trunc(X*sinY+Z*cosY);
  79.      X:=trunc(tX*cosZ+Y*sinZ);   {pitch}
  80.      tY:=trunc(Y*cosZ-tX*sinZ);
  81.      Z:=trunc(tZ*cosX-tY*sinX);  {roll}
  82.      Y:=trunc(tZ*sinX+tY*cosX)
  83. end;
  84.  
  85. procedure DefinePrism(rotX,rotY,rotZ:integer;scale:byte);
  86. var
  87.    x,y,z:integer;
  88.    i1:0..11;
  89.    i2:0..1;
  90. begin
  91.      for i1:=0 to 11 do
  92.      for i2:=0 to 1 do
  93.      begin
  94.           x:=(prism[i1,i2].x)*scale;
  95.           y:=(prism[i1,i2].y)*scale;
  96.           z:=(prism[i1,i2].z)*scale;
  97.           Rot3D(x,y,z,rotX,rotY,rotZ);
  98.           deltaPRISM[i1,i2].x:=x;
  99.           deltaPRISM[i1,i2].y:=y;
  100.           deltaPRISM[i1,i2].z:=z+deltaZ
  101.      end
  102. end;
  103. {<■────────────────────────────────────────────────────────────────────────■>}
  104. procedure DrawPrism(col:byte;where:word);
  105. var
  106.    i:0..11;
  107.    x,y,z,sX1,sX2:integer;
  108.    sY1,sY2:byte;
  109. begin
  110.      for i:=0 to 11 do
  111.      begin
  112.           x:=deltaPRISM[i,0].x;
  113.           y:=deltaPRISM[i,0].y;
  114.           z:=deltaPRISM[i,0].z;
  115.           Get2D(x,y,z,sX1,sY1);
  116.           x:=deltaPRISM[i,1].x;
  117.           y:=deltaPRISM[i,1].y;
  118.           z:=deltaPRISM[i,1].z;
  119.           Get2D(x,y,z,sX2,sY2);
  120.           line(sX1,sY1,sX2,sY2,col,where)
  121.      end
  122. end;
  123. {<■────────────────────────────────────────────────────────────────────────■>}
  124. begin
  125.  
  126.      for k:=0 to 359 do
  127.      begin
  128.           ValCos[k]:=cos(Deg2Rad(k));
  129.           ValSin[k]:=sin(Deg2Rad(k))
  130.      end;
  131.  
  132.      SetMCGA;
  133.      DefinePrism(0,0,0,64);
  134.      for k:=0 to 90 do
  135.      begin
  136.           DrawPrism(0,vga);
  137.           DefinePrism(k div 6,k div 6,k*4,86);
  138.           DrawPrism(15,vga)
  139.      end;
  140.      for k:=15 to 90 do
  141.      begin
  142.           DrawPrism(0,vga);
  143.           DefinePrism(k,k,k,86);
  144.           DrawPrism(15,vga)
  145.      end;
  146.      for k:=90 downto 0 do
  147.      begin
  148.           DrawPrism(0,vga);
  149.           DefinePrism(k*4,k*2,k*8,86);
  150.           DrawPrism(15,vga)
  151.      end;
  152.      while not keypressed do;
  153.      SetText
  154. end.
  155.